home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 2 / Atari Mega Archive CD - Volume 2.iso / 8bit / cislib_a / format.act < prev    next >
Text File  |  1995-04-22  |  6KB  |  329 lines
  1. ;
  2. ; FORMAT.ACT - Formats Action! sources
  3. ; with indented DO-OD, IF-FI pairs.
  4. ;
  5. ; by Harold Long
  6. ;
  7. ; Source should be in simple form, i.e.,
  8. ; one keyword per line, no "DO mumble OD"
  9. ; constructions, etc.
  10. ;
  11. CHAR ARRAY SOURCE(255), ;Temporary
  12.            DEST(255), ;String arrays
  13.            KEYWORD ;Test word pointer
  14. CARD ARRAY POS(6),NEG(6),RES(6),TEMP(6), LEAD(6) ;Keyword arrays
  15. BYTE I,J,K ;Counters
  16. BYTE CurPos=[0], ;Current character pointer
  17.      LastPos=[0], ;Last Character position
  18.      Spaces=[0], ;Current indent value
  19.      NextSpace=[0], ;Next line indent value
  20.      Indent=[2]  ;Number of spaces per indent
  21. INT  TempSpace=[0] ;Back up this line only
  22. ;
  23. ; Setup keyword arrays with desired values
  24. ; To include additional words, add to list
  25. ; and modify Foo(0) to reflect total number
  26. ; of words in list.
  27. ;
  28. PROC Setup()
  29.  POS(0)=2      ;Number of words in list
  30.  POS(1)="IF"   ;Roughly sorted by frequency
  31.  POS(2)="DO"
  32.  
  33.  NEG(0)=3
  34.  NEG(1)="FI"
  35.  NEG(2)="OD"
  36.  NEG(3)="RETURN"
  37.  
  38.  RES(0)=3
  39.  RES(1)="MODULE"
  40.  RES(2)="PROC"
  41.  RES(3)="FUNC"
  42.  
  43.  TEMP(0)=2
  44.  TEMP(1)="ELSE"
  45.  TEMP(2)="ELSEIF"
  46.  TEMP(3)="RETURN"
  47.  
  48.  LEAD(0)=4
  49.  LEAD(1)="BYTE"
  50.  LEAD(2)="CARD"
  51.  LEAD(3)="INT"
  52.  LEAD(4)="CHAR"
  53.  
  54.  TempSpace=-Indent
  55.  Spaces=Indent
  56. RETURN
  57.  
  58. ;
  59. ; Strip out all leading spaces.
  60. ; Returns with stripped data in
  61. ; SOURCE
  62. ;
  63. PROC Strip()
  64.  FOR I=1 to SOURCE(0) ;Count spaces
  65.  DO
  66.   IF SOURCE(I)#32 THEN ;Exit on first non-space char
  67.    EXIT
  68.   FI
  69.  OD
  70.  IF SOURCE(I)=155 THEN
  71.   SOURCE(0)=0
  72.   SOURCE(1)=155
  73.  FI
  74.  IF SOURCE(0)#0 THEN
  75.   ScopyS(DEST,SOURCE,I,SOURCE(0)) ;Move to delete spaces
  76.   ScopyS(SOURCE,DEST,1,DEST(0)) ;Put back in source record
  77.  FI
  78. RETURN
  79.  
  80. ;
  81. ; Extract substring: returns with
  82. ; start:(end-1) inclusive string in
  83. ; DEST
  84. ;
  85. PROC SubStr(BYTE Start, BYTE End)
  86.  IF End>Start THEN
  87.   DEST(0)=(End-Start)
  88.   FOR I=1 to DEST(0)
  89.    DO
  90.     DEST(I)=SOURCE(Start+I-1)
  91.    OD
  92.  ELSE
  93.   DEST(0)=0
  94.   DEST(1)=155
  95.  FI
  96. RETURN
  97.  
  98. ;
  99. ; Find delimiter: returns next occurrence
  100. ; of space char in SOURCE
  101. ;
  102. BYTE FUNC FindLim(BYTE Start, BYTE End)
  103.  IF End>Start THEN
  104.   FOR I=Start TO End
  105.    DO
  106.     IF SOURCE(I)=32 THEN
  107.      EXIT
  108.     FI
  109.    OD
  110.   ELSE
  111.    I=0
  112.  FI
  113. RETURN(I)
  114.  
  115. ;
  116. ; Test for lower case character
  117. ;
  118. BYTE FUNC IsLower(BYTE c)
  119.  IF (c>='a) AND (c<='z) THEN
  120.   RETURN(1)
  121.  FI
  122. RETURN(0)
  123.  
  124. ;
  125. ; Shift to upper case if lower
  126. ;
  127. BYTE FUNC ToUpper(BYTE c)
  128.  IF IsLower(c) THEN
  129.   c==-$20
  130.  FI
  131. RETURN(c)
  132.  
  133. ;
  134. ; Force substring to upper case just
  135. ; in case you forgot...
  136. ;
  137. PROC SubUp()
  138.  BYTE c
  139.  FOR I=1 to DEST(0)
  140.  DO
  141.   c=DEST(I)
  142.   DEST(I)=ToUpper(c)
  143.  OD
  144. RETURN
  145.  
  146. ; Test Positive indent; examine DEST
  147. ; for match with positive keyword
  148. ;
  149. BYTE FUNC TestPos()
  150.  BYTE Match
  151.  Match=0
  152.  FOR I=1 TO POS(0)
  153.  DO
  154.   KEYWORD=POS(I)
  155.   IF SCompare(DEST,KEYWORD)=0 THEN
  156.    Match=Indent
  157.   FI
  158.  OD
  159. RETURN(Match)
  160.  
  161. ;
  162. ; Test Negative indent; examine DEST
  163. ; for match with negative keyword
  164. ;
  165. BYTE FUNC TestNeg()
  166.  BYTE Match
  167.  Match=0
  168.  FOR I=1 to NEG(0)
  169.  DO
  170.   KEYWORD=NEG(I)
  171.   IF Scompare(DEST,KEYWORD)=0 THEN
  172.    Match=Indent
  173.   FI
  174.  OD
  175. RETURN(Match)
  176.  
  177. ;
  178. ; Test for Reset; cancel any
  179. ; outstanding pos/neg indents
  180. ;
  181. BYTE FUNC TestRes()
  182.  BYTE Match
  183.  Match=0
  184.  FOR I=1 to RES(0)
  185.  DO
  186.   KEYWORD=RES(I)
  187.   IF Scompare(DEST,KEYWORD)=0 THEN
  188.    Match=Indent
  189.   FI
  190.  OD
  191. RETURN(Match)
  192.  
  193. ;
  194. ; Test for Temporary reset; back up
  195. ; line one space to emphasize word.
  196. ;
  197. BYTE FUNC TestTemp()
  198.  BYTE Match
  199.  Match=0
  200.  FOR I=1 to TEMP(0)
  201.  DO
  202.   KEYWORD=TEMP(I)
  203.   IF Scompare(DEST,KEYWORD)=0 THEN
  204.    Match=Indent
  205.   FI
  206.  OD
  207. RETURN(Match)
  208.  
  209. ;
  210. ; Test for 'leader' word, e.g., complex
  211. ; expression such that keyword may follow
  212. ;
  213. BYTE FUNC TestLead()
  214.  BYTE Match
  215.  Match=0
  216.  FOR I=1 to LEAD(0)
  217.  DO
  218.   KEYWORD=LEAD(I)
  219.   IF SCompare(DEST,KEYWORD)=0 THEN
  220.    Match=1
  221.   FI
  222.  OD
  223. RETURN(Match)
  224.  
  225. ;
  226. ; File handler; 
  227. ;
  228. ; Opens Foo.ACT as input and
  229. ; Foo.FCT as output. Default
  230. ; filename is "TEST".
  231. ;
  232. PROC FOpen(BYTE ARRAY FName)
  233.  BYTE ARRAY INAME(16)  ;Input file name
  234.  BYTE ARRAY ONAME(16)  ;Output file
  235.  BYTE ARRAY IEXT=".ACT"
  236.  BYTE ARRAY OEXT=".FCT"
  237.  IF FName(0)=0 THEN
  238.   Scopy(Fname,"D:TEST")
  239.  FI
  240.  FOR I=1 TO FName(0)
  241.   DO
  242.    INAME(I)=FName(I)
  243.    ONAME(I)=FName(I)
  244.   OD
  245.  FOR I=FName(0)+1 TO FName(0)+4
  246.   DO
  247.    INAME(I)=IEXT(I-FName(0))
  248.    ONAME(I)=OEXT(I-FName(0))
  249.   OD
  250.  INAME(0)=FNAME(0)+4
  251.  ONAME(0)=FNAME(0)+4
  252.  OPEN(2,INAME,4,0)     ;Input is read only
  253.  OPEN(3,ONAME,8,0)     ;Output is write only
  254. RETURN
  255.  
  256. ;
  257. ; Process Record; inputs a line from
  258. ; Foo.ACT, strips it, tests for leading
  259. ; keywords, adjusts indentation, and
  260. ; outputs to Foo.FCT.
  261. PROC ProcRec()
  262.  InputSD(2,SOURCE)     ;Get record
  263.  Strip()               ;Delete leading spaces
  264.  IF SOURCE(0)>0 THEN   ;Skip blank lines
  265.   CurPos=FindLim(1,SOURCE(0)) ;Find delimiter
  266.   SubStr(1,CurPos)      ;extract substring
  267.   SubUp()              ;Upper case
  268.   IF TestLead() THEN   ;Complex expression?
  269.    LastPos=Curpos+1
  270.    CurPos=FindLim(LastPos,Source(0)) ;Get next word
  271.    SubStr(LastPos,Curpos) ;Extract
  272.    SubUp()             ;Upper case
  273.   FI
  274.   IF TestRes()#0 OR SOURCE(1)='; THEN
  275.    Spaces=Indent
  276.    TempSpace=-Indent
  277.   FI
  278.   Spaces==-TestNeg()
  279.   NextSpace=TestPos()
  280.   TempSpace==-TestTemp()
  281.   CurPos=Spaces+TempSpace+1
  282.   FOR I=1 TO 254        ;Blank target line
  283.    DO
  284.     DEST(I)=32
  285.    OD
  286.   DEST(0)=254
  287.   DEST(255)=155
  288.   SAssign(DEST,SOURCE,Curpos,SOURCE(0)+CurPos)
  289.   ScopyS(SOURCE,DEST,1,SOURCE(0)+Curpos)
  290.   TempSpace=0
  291.  FI
  292.  PrintDE(3,SOURCE)      ;Write record
  293.  Spaces==+NextSpace
  294. RETURN
  295.  
  296. PROC Main()
  297. BYTE ARRAY File(20)
  298.  CLOSE(2)
  299.  CLOSE(3)
  300.  GRAPHICS(0)           ;CLEAR SCREEN
  301.  POSITION(10,2)
  302.  PRINTE("Action! Formatter")
  303.  POSITION(2,4)
  304.  PRINTE("Formats Action! source files with")
  305.  POSITION(2,5)
  306.  PRINTE("indented DO-OD, IF-FI, etc. pairs.")
  307.  POSITION(2,7)
  308.  PRINTE("Specify input file as Dn:mumble")
  309.  POSITION(2,8)
  310.  PRINTE("Input extension of .ACT is assumed.")
  311.  POSITION(2,9)
  312.  PRINTE("Output file will be Dn:mumble.FCT")
  313.  Position(2,11)
  314.  PRINT("Input: ")
  315.  INPUTS(File)
  316.  FOpen(File)
  317.  Setup()
  318.  WHILE EOF(2)=0
  319.  DO
  320.   ProcRec()
  321.  OD
  322.  CLOSE(2)
  323.  CLOSE(3)
  324.  POSITION(2,13)
  325.  PRINTE("DONE!")
  326. RETURN
  327.  
  328.  
  329.